home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / a_search < prev    next >
Text File  |  1996-06-01  |  4KB  |  128 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- search_alg.sa: 
  3. -- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
  4. -- Copyright (C) 1995, International Computer Science Institute
  5. -- $Id: a_search.sa,v 1.3 1996/06/01 21:36:10 gomes Exp $
  6. --
  7. -- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
  8. -- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
  9. -- LICENSE contained in the file: Sather/Doc/License of the
  10. -- Sather distribution. The license is also available from ICSI,
  11. -- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
  12. -------------------------------------------------------------------
  13.  
  14. class A_SEARCH{ETP,ATP<$ARR{ETP}} 
  15. -- Searching algorithms on arrays.
  16. -- Note that the element comparison is defined here bu the percondition
  17. -- checks may use a different lt when calling  the is_sorted routine
  18. -- in A_SORT
  19. is
  20.    include COMPARE{ETP};
  21.    
  22.    private is_sorted(a: ATP,l,u:INT): BOOL is
  23.       return A_SORT{ETP,ATP}::is_sorted(a,l,u);
  24.    end;
  25.    
  26.    binary_search(a: ATP,e: ETP): INT is 
  27.       return binary_search(a,e,0,a.size-1);
  28.    end;
  29.    
  30.    binary_search(a: ATP,e:ETP,l,u: INT):INT 
  31.       -- Assuming self is sorted, return the index of the element
  32.       -- preceding the first element greater than `e' according to
  33.       -- `elt_lt' in the range [l,u].
  34.       -- -1 if all elements are greater than `e'.
  35.       pre check_range(a,l,u) and is_sorted(a,l,u) 
  36.    is
  37.       if ~elt_lt(e,a[u]) then return u end;
  38.       if elt_lt(e,a[l]) then return -1 end;
  39.       -- From now on [u] is always known to be greater than `e', and
  40.       -- [l] is not greater than `e'.
  41.       loop while!(u>l+1); j::=(u+l)/2;
  42.      if elt_lt(e,a[j]) then u:=j 
  43.      else l:=j end 
  44.       end;
  45.       return l 
  46.    end;
  47.  
  48.    binary_search(a: ATP,e:ETP,lt: ROUT{ETP,ETP}:BOOL,l,u: INT):INT 
  49.       -- Assuming self is sorted, return the index of the element
  50.       -- preceding the first element greater than `e' according to
  51.       -- `elt_lt' in the range [l,u].
  52.       -- -1 if all elements are greater than `e'.
  53.       pre check_range(a,l,u) and is_sorted(a,l,u) 
  54.    is
  55.       if ~elt_lt(e,a[u]) then return u end;
  56.       if elt_lt(e,a[l]) then return -1 end;
  57.       -- From now on [u] is always known to be greater than `e', and
  58.       -- [l] is not greater than `e'.
  59.       loop while!(u>l+1); j::=(u+l)/2;
  60.      if lt.call(e,a[j]) then u:=j 
  61.      else l:=j end 
  62.       end;
  63.       return l 
  64.    end;
  65.  
  66.    index_of(a: ATP, e: ETP): INT is
  67.       -- Return the index of the elemetn 'e' in 'a'
  68.       -- Return -1 if the element is not found. Does not assume a is sorted
  69.       i ::= 0; loop until!(i>a.size); 
  70.      if elt_eq(e,a[i]) then return i end;
  71.      i := i + 1; 
  72.       end;
  73.    end;
  74.  
  75.  
  76.    index_if(a: ATP,test:ROUT{ETP}:BOOL):INT is
  77.       -- Return the index of the leftmost element that satisfies `test', 
  78.       -- or -1 if there is none. 
  79.       loop 
  80.      r::=0.upto!(a.size-1);
  81.      if test.call(a[r]) then return r end 
  82.       end; 
  83.       return -1 
  84.    end;
  85.    
  86.    match_subarray(a: ATP, marr:ARRAY{ETP},l,u: INT):INT 
  87.    -- The index of the leftmost subarray of marr which matches 'a'
  88.    -- Confine search to subrange [l,u] of a
  89.    -- -1 if none. Uses simple algorithm which has good performance 
  90.    -- unless the arrays are special (eg. many repeated values).
  91.    -- Also uses ARRAY{ETP} rather than a general $ARR since it
  92.    -- will almost certainly be worthwhile to copy into a concrete
  93.    -- class rather than use dispatching on the argument
  94.       pre check_range(a,l,u)
  95.    is
  96.       loop 
  97.      r::=l.upto!(u-marr.size); 
  98.      match::=true;
  99.      mind: INT := 0; 
  100.      msz: INT := marr.size;
  101.      -- Check for a match from location r to the end of 'a' or 'marr'
  102.      loop until!(mind >= (u-r) or mind >= msz);
  103.         if ~elt_eq(a[mind+r],marr[mind]) then match:=false; break! end;
  104.         mind := mind+1;
  105.      end;
  106.      if match=true then return r end 
  107.       end; 
  108.       return -1 
  109.    end;
  110.    
  111.    private check_range(a: ATP,l,u: INT): BOOL is
  112.       if void(a) then
  113.      #ERR+"The sort array is void!\n"; return false;
  114.       end;
  115.       if l.is_bet(0,a.size-1) and u.is_bet(l,a.size-1) then
  116.      return true;
  117.       else 
  118.      #ERR+"Can't sort the specified range:["+l+","+u+"]\n";
  119.      #ERR+"The array is of size:"+a.size+"\n";
  120.      return false;
  121.       end;
  122.    end;
  123.  
  124.  
  125. end; -- class A_SEARCH{ETP,ATP<$ARR{ETP}}
  126. -------------------------------------------------------------------
  127.  
  128.